Option Explicit
Private Sub Command1_Click()
End
End Sub
Private Sub Form_Load()
Dim Bk As Integer, Ch As Integer, Sect As Integer, ItemIndex As Integer
Dim BookIndex As Integer
Dim size As Integer
Dim CellFont As New StdFont
Randomize
With SftTree1
' Mass-Update
.BulkUpdate = True
' set default item graphic. This can also be done at design time
Set .Items.ItemImageExpandable.Picture = BookClosed.Picture
Set .Items.ItemImageExpanded.Picture = BookOpen.Picture
Set .Items.ItemImageLeaf.Picture = Topic.Picture
' set the column header images (to indicate sorting)
SftTree1.Header(0).Image.Appearance = sftImageSortAsc
SftTree1.Header(1).Image.Clear
SftTree1.Header(2).Image.Clear
' set the cell font for books
Set CellFont = Font
CellFont.Bold = True
' Add all available options
For Bk = 1 To 4
' add a book
BookIndex = .Items.Add("Book " & Bk)
.Cell(BookIndex, 1).Text = "Description for book " & Bk
size = Int((1000 * Rnd) + 1)
.Cell(BookIndex, 2).Text = size
.Item(BookIndex).Data = size
' add chapters
For Ch = 1 To 2
ItemIndex = .Items.Add("Chapter " & Ch)
.Item(ItemIndex).Level = 1
' add sections
For Sect = 1 To 2
ItemIndex = .Items.Add("Section " & Sect)
.Item(ItemIndex).Level = 2
Next Sect
Next Ch
' after adding the book and all dependent items, we
' collapse the item, so it's up to the user to expand it
.Item(BookIndex).Collapse False
' set font
Set .Cell(BookIndex, 0).Font = CellFont
Next Bk
' End of Mass-Update
.BulkUpdate = False
' Make columns optimal
.ColumnsObj.MakeOptimal
' allow horizontal scrolling
.Items.RecalcHorizontalExtent
End With
End Sub
Private Sub ShowPlusMin_Click()
If ShowPlusMin.Value = 0 Then
SftTree1.Items.PlusMinusImageExpandable.Clear
SftTree1.Items.PlusMinusImageExpanded.Clear
Else
Set SftTree1.Items.PlusMinusImageExpandable.Picture = Plus.Picture
Set SftTree1.Items.PlusMinusImageExpanded.Picture = Minus.Picture
End If
End Sub
Private Sub Ugly_Click()
If Ugly.Value = 0 Then
SftTree1.ButtonPicture = Nothing
Else
Set SftTree1.ButtonPicture = UglyButtons.Picture
End If
End Sub
Private Sub SortHeader(ByVal ColIndex As Integer)
With SftTree1
If .Header(ColIndex).Image.Appearance = sftImageSortAsc Then
' Sort the data. Note that column 2 is sorted by Item.Data, which is
' an integer value (book size in pages)
If ColIndex = 2 Then
.Items.SortDependents -1, ColIndex, sortSftTreeDscItemData
Else
.Items.SortDependents -1, ColIndex, sortSftTreeDescending
End If
.Header(ColIndex).Image.Appearance = sftImageSortDesc
Else
.Header(0).Image.Clear
.Header(1).Image.Clear
.Header(2).Image.Clear
' Sort the data. Note that column 2 is sorted by Item.Data, which is
' an integer value (book size in pages)
If ColIndex = 2 Then
.Items.SortDependents -1, ColIndex, sortSftTreeAscItemData
Else
.Items.SortDependents -1, ColIndex, sortSftTreeAscending
End If
.Header(ColIndex).Image.Appearance = sftImageSortAsc
End If
End With
End Sub
Private Sub HeaderMenu()
Dim Count As Integer
Count = 0
If SftTree1.Column(0).WidthPix > 0 Then
MenuForm.ShowContents.Checked = True
Count = Count + 1
Else
MenuForm.ShowContents.Checked = False
End If
If SftTree1.Column(1).WidthPix > 0 Then
MenuForm.ShowDescription.Checked = True
Count = Count + 1
Else
MenuForm.ShowDescription.Checked = False
End If
If SftTree1.Column(2).WidthPix > 0 Then
MenuForm.ShowSize.Checked = True
Count = Count + 1
Else
MenuForm.ShowSize.Checked = False
End If
If Count <= 1 Then
If MenuForm.ShowContents.Checked Then MenuForm.ShowContents.Enabled = False
If MenuForm.ShowDescription.Checked Then MenuForm.ShowDescription.Enabled = False
If MenuForm.ShowSize.Checked Then MenuForm.ShowSize.Enabled = False
Else
MenuForm.ShowContents.Enabled = True
MenuForm.ShowDescription.Enabled = True
MenuForm.ShowSize.Enabled = True
End If
MenuForm.ShowAll.Enabled = Count < 3
SftTree1.CancelMode
PopupMenu MenuForm.HeaderPopup
End Sub
Private Sub SftTree1_ContextMenu(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' Determine click context menu for header or item
Dim l As Single, t As Single, h As Single, w As Single
SftTree1.Headers.GetPosition l, t, w, h
If X >= l And X < l + w And Y >= t And Y <= t + h Then
HeaderMenu
Exit Sub
End If
' determine item right-clicked
Dim ItemIndex As Long
ItemIndex = SftTree1.Items.HitTest(X, Y)
If ItemIndex >= 0 And ItemIndex < SftTree1.Items.Count Then
SftTree1.Items.Current = ItemIndex
SftTree1.Item(ItemIndex).Selected = True
SftTree1.CancelMode
PopupMenu MenuForm.ItemPopup
End If
End Sub
Private Sub SftTree1_ItemClick(ByValItemIndex As Long, ByVal ColIndex As Integer, ByVal AreaType As Integer, ByVal Button As Integer, ByVal Shift As Integer)
With SftTree1
If AreaType = constSftTreeColumnHeader And Button = constSftTreeLeftButton Then
SortHeader ColIndex
ElseIf AreaType = constSftTreeExpandAll Then
.Item(ItemIndex).Expand False, True
End If
End With
End Sub
Private Sub SftTree1_ItemDblClick(ByVal ItemIndex As Long, ByVal ColIndex As Integer, ByVal AreaType As Integer, ByVal Button As Integer, ByVal Shift As Integer)
With SftTree1
If AreaType = constSftTreeColumnRes And Button = constSftTreeLeftButton Then
.Column(ColIndex).MakeOptimal
.Items.RecalcHorizontalExtent
ElseIf AreaType = constSftTreeColumnHeader And Button = constSftTreeLeftButton Then
SortHeader ColIndex
End If
End With
End Sub